home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / pc / MYPROGS.ZIP / STETRIS.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-04-06  |  6.0 KB  |  216 lines
  1. program super_tetris;
  2. uses crt;
  3. const nbpiece=27;
  4.       large=20;
  5.       haut=23;
  6.       gauche='4';
  7.       droite='6';
  8.       tombe='2';
  9.       rotation=' ';
  10.       temporisation=8000;
  11.       xposition_depart=4;
  12.       yposition_depart=4;
  13.       block='▓▓';
  14. type p = RECORD
  15.                x: array[1..4] of integer;
  16.                y: array[1..4] of integer;
  17.                c: byte;
  18.              END;
  19.      ens   = array [0..nbpiece] of p;
  20.      tab     = array [1..large,1..haut] of byte;
  21.  
  22. var e : ens;
  23.     i,j,k,ti,tj: integer;
  24.     a: char;
  25.     t: tab;
  26.     xp,yp,xa,ya,nb: byte;
  27.  
  28. PROCEDURE INIT;
  29. BEGIN
  30.   for i:=0 to nbpiece do
  31.     for j:=1 to 4 do
  32.        BEGIN
  33.          e[i].x[j]:=0;
  34.          e[i].y[j]:=0;
  35.          e[i].c:=3;
  36.        END;
  37.   with e[0] do  BEGIN x[1]:=-1;x[3]:=1;x[4]:=2;END;
  38.   with e[1] do  BEGIN x[1]:=-1;x[3]:=1;x[4]:=0;y[4]:=1;END;
  39.   with e[2] do  BEGIN x[1]:=-1;x[3]:=1;x[4]:=-1;y[4]:=1;END;
  40.   with e[3] do  BEGIN x[2]:=1;x[4]:=1;y[3]:=1;y[4]:=1;END;
  41.   with e[4] do  BEGIN x[1]:=-1;x[3]:=1;x[4]:=1;y[4]:=1;END;
  42.   with e[5] do  BEGIN x[2]:=1;x[4]:=1;y[3]:=-1;y[4]:=1;END;
  43.   with e[6] do  BEGIN x[2]:=1;x[4]:=1;y[3]:=1;y[4]:=-1;END;
  44.   with e[7] do  BEGIN y[1]:=-2;y[2]:=-1;y[4]:=1;END;
  45.   with e[8] do  BEGIN x[4]:=1;y[1]:=-1;y[3]:=1;END;
  46.   with e[9] do  BEGIN x[4]:=1;y[1]:=-1;y[3]:=1;y[4]:=1;END;
  47.   with e[10] do  BEGIN x[2]:=1;x[4]:=1;y[3]:=1;y[4]:=1;END;
  48.   with e[11] do  BEGIN x[4]:=1;y[1]:=-1;y[3]:=1;y[4]:=-1;END;
  49.   with e[12] do  BEGIN x[2]:=1;x[3]:=-1;y[3]:=1;y[4]:=1;END;
  50.   with e[13] do  BEGIN x[2]:=-1;x[4]:=1;y[3]:=1;y[4]:=1;END;
  51.   with e[14] do  BEGIN x[1]:=-1;x[3]:=1;x[4]:=2;END;
  52.   with e[15] do  BEGIN x[1]:=-1;x[3]:=1;y[4]:=-1;END;
  53.   with e[16] do  BEGIN x[1]:=-1;x[3]:=1;x[4]:=1;y[4]:=-1;END;
  54.   with e[17] do  BEGIN x[2]:=1;x[4]:=1;y[3]:=1;y[4]:=1;END;
  55.   with e[18] do  BEGIN x[1]:=-1;x[3]:=1;x[4]:=-1;y[4]:=-1;END;
  56.   with e[19] do  BEGIN x[2]:=1;x[4]:=1;y[3]:=-1;y[4]:=1;END;
  57.   with e[20] do  BEGIN x[2]:=1;x[4]:=1;y[3]:=1;y[4]:=-1;END;
  58.   with e[21] do  BEGIN y[1]:=-2;y[2]:=-1;y[4]:=1;END;
  59.   with e[22] do  BEGIN x[1]:=-1;y[4]:=1;y[3]:=-1;END;
  60.   with e[23] do  BEGIN x[1]:=-1;y[1]:=-1;y[2]:=-1;y[4]:=1;END;
  61.   with e[24] do  BEGIN x[2]:=1;x[4]:=1;y[3]:=1;y[4]:=1;END;
  62.   with e[25] do  BEGIN x[4]:=-1;y[1]:=-1;y[3]:=1;y[4]:=1;END;
  63.   with e[26] do  BEGIN x[2]:=1;x[3]:=-1;y[3]:=1;y[4]:=1;END;
  64.   with e[27] do  BEGIN x[2]:=-1;x[4]:=1;y[3]:=1;y[4]:=1;END;
  65.  
  66.   for i:=1 to large do
  67.      for j:=1 to haut do t[i,j]:=0;
  68.   for i:=1 to large do t[i,haut]:=255;
  69.   for i:=1 to haut do  BEGIN
  70.                          t[1,i]:=255;
  71.                          t[large,i]:=255;
  72.                        END;
  73. END;
  74.  
  75. FUNCTION collision(nb,xp,yp: byte):boolean;
  76. var test: boolean;
  77. BEGIN
  78.  test:=false;
  79.  for i:=1 to 4 do
  80.              if t[xp+e[nb].x[i],yp+e[nb].y[i]]<>0 then test:=true;
  81.  collision:=test;
  82. END;
  83.  
  84. PROCEDURE AFFICHE_PIECE;
  85. BEGIN
  86.   for i:=1 to 4 do BEGIN
  87.                gotoxy((xp+e[nb].x[i])*2,yp+e[nb].y[i]);
  88.                write(block);
  89.               END;
  90. END;
  91. PROCEDURE EFFACE_PIECE;
  92. BEGIN
  93.   for i:=1 to 4 do BEGIN
  94.                gotoxy((xp+e[nb].x[i])*2,yp+e[nb].y[i]);
  95.                write('  ');
  96.               END;
  97. END;
  98.  
  99. PROCEDURE AFFICHE_TABLEAU;
  100. BEGIN
  101.   for i:=1 to large do
  102.       for j:=1 to haut do
  103.        BEGIN
  104.          gotoxy(i*2,j);
  105.          if t[i,j]=0 then write('  ')
  106.          else write(block);
  107.        END;
  108. END;
  109. PROCEDURE TESTE_LIGNE;
  110. var test: boolean;
  111. BEGIN
  112. j:=haut-1;
  113. repeat
  114.   test:=true;
  115.   for i:=2 to large-1 do
  116.      if t[i,j]=0 then test:=false;
  117.   dec(j);
  118. until (test) or (j=1);
  119. inc(j);
  120. if test then
  121.            BEGIN
  122.              for tj:=j downto 2 do
  123.                for i:=1 to large do
  124.                          t[i,tj]:=t[i,tj-1];
  125.              END;
  126. if test then BEGIN
  127.                   AFFICHE_TABLEAU;
  128.              END;
  129. END;
  130.  
  131.  
  132. PROCEDURE GERE_TOUCHE(a:char);
  133. var nbtampon:byte;
  134. BEGIN
  135.   case a of
  136.     gauche: if not(collision(nb,xp-1,yp)) then
  137.                                               BEGIN
  138.                                               efface_piece;
  139.                                               xp:=xp-1;
  140.                                               END;
  141.     droite: if not(collision(nb,xp+1,yp)) then
  142.                                               BEGIN
  143.                                               efface_piece;
  144.                                               xp:=xp+1;
  145.                                               END;
  146.     tombe: k:=temporisation*4;
  147.     rotation: BEGIN
  148.                efface_piece;
  149.                nbtampon:=nb;
  150.                if nb+7>nbpiece then nbtampon:=nb-21
  151.                                else nbtampon:=nb+7;
  152.                if not(collision(nbtampon,xp,yp)) then nb:=nbtampon;
  153.               END;
  154.     END;
  155.    affiche_piece;
  156. END;
  157.  
  158. function DESCENDRE:boolean;
  159. BEGIN
  160.   if not(collision(nb,xp,yp+1)) then
  161.                                 BEGIN
  162.                                   EFFACE_PIECE;
  163.                                   yp:=yp+1;
  164.                                   DESCENDRE:=TRUE;
  165.                                 END
  166.                else
  167.                  DESCENDRE:=FALSE;
  168. END;
  169.  
  170. PROCEDURE INSERE_PIECE_DANS_TAB;
  171. BEGIN
  172. for i:=1 to 4 do t[xp+e[nb].x[i],yp+e[nb].y[i]]:=255;
  173. END;
  174.  
  175.  
  176. PROCEDURE NOUVELLE_PIECE;
  177. BEGIN
  178.   xp:=xposition_depart;
  179.   yp:=yposition_depart;
  180.   nb:=random(28);
  181. END;
  182.  
  183. BEGIN
  184. randomize;
  185. a:='g';
  186. init;
  187. clrscr;
  188. AFFICHE_TABLEAU;
  189. NOUVELLE_PIECE;
  190. AFFICHE_PIECE;
  191. k:=0;
  192. repeat
  193.     repeat
  194.      inc(k);
  195.      until (keypressed) or (k>temporisation);
  196.      if keypressed then
  197.                  BEGIN
  198.                  a:=readkey;
  199.                  gere_touche(a);
  200.                  END;
  201.     if k>temporisation then
  202.         BEGIN
  203.           k:=k-temporisation;
  204.           if not(DESCENDRE) then
  205.                             BEGIN
  206.                               INSERE_PIECE_DANS_TAB;
  207.                               for ti:=1 to 4 do TESTE_LIGNE;
  208.                               NOUVELLE_PIECE;
  209.                               k:=0;
  210.                             END;
  211.         END;
  212.     AFFICHE_PIECE;
  213. until a='q';
  214. END.
  215.  
  216.